home *** CD-ROM | disk | FTP | other *** search
/ Technotools / Technotools (Chestnut CD-ROM)(1993).ISO / lang_c / cug231 / interp.c < prev    next >
Text File  |  1987-06-17  |  12KB  |  429 lines
  1. /*
  2.     Little Smalltalk
  3.         bytecode interpreter
  4.         timothy a. budd
  5. */
  6. /*
  7.     The source code for the Little Smalltalk System may be freely
  8.     copied provided that the source of all files is acknowledged
  9.     and that this condition is copied with each file.
  10.  
  11.     The Little Smalltalk System is distributed without responsibility
  12.     for the performance of the program and without any guarantee of
  13.     maintenance.
  14.  
  15.     All questions concerning Little Smalltalk should be addressed to:
  16.  
  17.         Professor Tim Budd
  18.         Department of Computer Science
  19.         Oregon State University
  20.         Corvallis, Oregon
  21.         97331
  22.         USA
  23. */
  24. # include <stdio.h>
  25. # include "object.h"
  26. # include "drive.h"
  27. # include "cmds.h"
  28. # include "interp.h"
  29. # include "process.h"
  30. # include "number.h"
  31. # include "string.h"
  32. # include "symbol.h"
  33. # include "byte.h"
  34. # include "block.h"
  35. # include "primitive.h"
  36.  
  37. int opcount[16], ohcount, spcount[16];
  38. extern object *o_smalltalk;    /* value of pseudo variable smalltalk */
  39. extern object *fnd_class();    /* used to find classes from names */
  40.  
  41. static mstruct *fr_interp = 0;    /* interpreter memory free list */
  42. int ca_terp = 0;        /* counter for interpreter allocations */
  43.  
  44. /* cr_interpreter - create a new interpreter */
  45. interpreter *cr_interpreter(sender, receiver, literals, bitearray, context)
  46. interpreter *sender;
  47. object *literals, *bitearray, *receiver, *context;
  48. {    interpreter *new;
  49.     class *rclass;
  50.     int isize;
  51.  
  52.     if (fr_interp) {
  53.         new = (interpreter *) fr_interp;
  54.         fr_interp = fr_interp->mlink;
  55.         }
  56.     else {
  57.         new = structalloc(interpreter);
  58.         ca_terp++;
  59.         }
  60.  
  61.     new->t_ref_count = 0;
  62.     new->t_size = INTERPSIZE;
  63.  
  64.     new->creator = (interpreter *) 0;
  65.     if (sender)
  66.         sassign(new->sender, sender);
  67.     else
  68.         sassign(new->sender, (interpreter *) o_nil);
  69.     sassign(new->literals, literals);
  70.     sassign(new->bytecodes, bitearray);
  71.     sassign(new->receiver, receiver);
  72.     rclass = (class *) fnd_class(receiver);
  73.     if ((! rclass) || ! is_class(rclass))
  74.         isize = 25;
  75.     else {
  76.         isize = rclass->stack_max;
  77.         }
  78.     sassign(new->context, context);
  79.     sassign(new->stack, new_obj((class *) 0, isize, 1));
  80.     new->stacktop = &(new->stack)->inst_var[0];
  81.     new->currentbyte = byte_value(new->bytecodes);
  82.     return(new);
  83. }
  84.  
  85. /* free_terpreter - return an unused interpreter to free list */
  86. free_terpreter(anInterpreter)
  87. interpreter *anInterpreter;
  88. {
  89.     if (! is_interpreter(anInterpreter))
  90.         cant_happen(8);
  91.  
  92.     obj_dec((object *) anInterpreter->sender);
  93.     obj_dec(anInterpreter->receiver);
  94.     obj_dec(anInterpreter->bytecodes);
  95.     obj_dec(anInterpreter->literals);
  96.     obj_dec(anInterpreter->context);
  97.     obj_dec(anInterpreter->stack);
  98.  
  99.     ((mstruct *) anInterpreter)->mlink = fr_interp;
  100.     fr_interp = (mstruct *) anInterpreter;
  101. }
  102.  
  103. /* copy_arguments - copy an array of arguments into the context */
  104. copy_arguments(anInterpreter, argLocation, argCount, argArray)
  105. interpreter *anInterpreter;
  106. int argLocation, argCount;
  107. object **argArray;
  108. {    object *context = anInterpreter->context;
  109.     int i;
  110.  
  111.     for (i = 0; i < argCount; argLocation++, i++) {
  112.         assign(context->inst_var[ argLocation ], argArray[i]);
  113.         }
  114. }
  115.  
  116. # define push(x) {assign(*(anInterpreter->stacktop), x); \
  117.             anInterpreter->stacktop++;}
  118.  
  119. /* push_object - push a returned value on to an interpreter stack */
  120. push_object(anInterpreter, anObject)
  121. interpreter *anInterpreter;
  122. object *anObject;
  123. {
  124.     push(anObject); /* what? no bounds checking?!? */
  125. }
  126.  
  127. # define nextbyte(x) {x = uctoi(*anInterpreter->currentbyte);\
  128. anInterpreter->currentbyte++;}
  129. # define instvar(x) (anInterpreter->receiver)->inst_var[ x ]
  130. # define tempvar(x) (anInterpreter->context)->inst_var[ x ]
  131. # define lit(x)     (anInterpreter->literals)->inst_var[ x ]
  132. # define popstack() (*(--anInterpreter->stacktop))
  133. # define decstack(x) (anInterpreter->stacktop -= x)
  134. # define skip(x)    (anInterpreter->currentbyte += x )
  135.  
  136. /* resume - resume executing bytecodes associated with an interpreter */
  137. resume(anInterpreter)
  138. register interpreter *anInterpreter;
  139. {
  140.     int highBits;
  141.     register int lowBits;
  142.     object *tempobj, *receiver, *fnd_super();
  143.     interpreter *sender;
  144.     int i, j, numargs, arglocation;
  145.     char *message;
  146.  
  147.     while(1) {
  148.         nextbyte(highBits);
  149.         lowBits = highBits % 16;
  150.         highBits /= 16;
  151.  
  152.         switchtop:
  153.         opcount[highBits]++;
  154.         switch(highBits) {
  155.             default: cant_happen(9);
  156.                 break;
  157.  
  158.             case 0:    /* two bit form */
  159.                 highBits = lowBits;
  160.                 nextbyte(lowBits);
  161.                 goto switchtop;
  162.  
  163.             case 1: /* push instance variable */
  164.                 push(instvar(lowBits));
  165.                 break;
  166.  
  167.             case 2: /* push context value */
  168.                 push(tempvar(lowBits));
  169.                 break;
  170.  
  171.             case 3: /* literals */
  172.                 push(lit(lowBits));
  173.                 break;
  174.  
  175.             case 4: /* push class */
  176.                 tempobj = lit(lowBits);
  177.                 if (! is_symbol(tempobj)) cant_happen(9);
  178.                 tempobj = primitive(FINDCLASS, 1, &tempobj);
  179.                 push(tempobj);
  180.                 break;
  181.  
  182.             case 5: /* special literals */
  183.                 if (lowBits < 10)
  184.                     tempobj = new_int(lowBits);
  185.                 else if (lowBits == 10)
  186.                     tempobj = new_int(-1);
  187.                 else if (lowBits == 11)
  188.                     tempobj = o_true;
  189.                 else if (lowBits == 12)
  190.                     tempobj = o_false;
  191.                 else if (lowBits == 13)
  192.                     tempobj = o_nil;
  193.                 else if (lowBits == 14)
  194.                     tempobj = o_smalltalk;
  195.                 else if (lowBits == 15)
  196.                     tempobj = (object *) runningProcess;
  197.                 else if ((lowBits >= 30) && (lowBits < 60)) {
  198.                     /* get class */
  199.                     tempobj =
  200.                         new_sym(classpecial[lowBits-30]);
  201.                     tempobj = primitive(FINDCLASS, 1,
  202.                         &tempobj);
  203.                     }
  204.                 else tempobj = new_int(lowBits);
  205.                 push(tempobj);
  206.                 break;
  207.  
  208.             case 6: /* pop and store instance variable */
  209.                 assign(instvar(lowBits), popstack());
  210.                 break;
  211.  
  212.             case 7: /* pop and store in context */
  213.                 assign(tempvar(lowBits), popstack());
  214.                 break;
  215.  
  216.             case 8: /* send a message */
  217.                 numargs = lowBits;
  218.                 nextbyte(i);
  219.                 tempobj = lit(i);
  220.                 if (! is_symbol(tempobj)) cant_happen(9);
  221.                 message = symbol_value(tempobj);
  222.                 goto do_send;
  223.  
  224.             case 9: /* send a superclass message */
  225.                 numargs = lowBits;
  226.                 nextbyte(i);
  227.                 tempobj = lit(i);
  228.                 if (! is_symbol(tempobj)) cant_happen(9);
  229.                 message = symbol_value(tempobj);
  230.                 receiver =
  231.                     fnd_super(anInterpreter->receiver);
  232.                 goto do_send2;
  233.  
  234.             case 10: /* send a special unary message */
  235.                 numargs = 0;
  236.                 message = unspecial[lowBits];
  237.                 goto do_send;
  238.  
  239.             case 11: /* send a special binary message */
  240.                 numargs = 1;
  241.                 message = binspecial[lowBits];
  242.                 goto do_send;
  243.  
  244.             case 12: /* send a special arithmetic message */
  245.                 tempobj = *(anInterpreter->stacktop - 2);
  246.                 if (! is_integer(tempobj)) goto ohwell;
  247.                 i = int_value(tempobj);
  248.                 tempobj = *(anInterpreter->stacktop - 1);
  249.                 if (! is_integer(tempobj)) goto ohwell;
  250.                 j = int_value(tempobj);
  251.                 decstack(2);
  252.                 switch(lowBits) {
  253.                     case 0: i += j; break;
  254.                     case 1: i -= j; break;
  255.                     case 2: i *= j; break;
  256.                     case 3: if (i < 0) i = -i;
  257.                         i %= j; break;
  258.                     case 4: if (j < 0) i >>= (-j);
  259.                         else i <<= j; break;
  260.                     case 5: i &= j; break;
  261.                     case 6: i |= j; break;
  262.                     case 7: i = (i < j); break;
  263.                     case 8: i = (i <= j); break;
  264.                     case 9: i = (i == j); break;
  265.                     case 10: i = (i != j); break;
  266.                     case 11: i = (i >= j); break;
  267.                     case 12: i = (i > j); break;
  268.                     case 13: i %= j; break;
  269.                     case 14: i /= j; break;
  270.                     case 15: i = (i < j) ? i : j;
  271.                         break;
  272.                     case 16: i = (i < j) ? j : i;
  273.                         break;
  274.                     default: cant_happen(9);
  275.                     }
  276.                 if ((lowBits < 7) || (lowBits > 12))
  277.                     tempobj = new_int(i);
  278.                 else tempobj = (i ? o_true : o_false);
  279.                 push(tempobj);
  280.                 break;
  281.  
  282.                 ohwell: /* oh well, send message */
  283.                 ohcount++;
  284.                 numargs = 1;
  285.                 message = arithspecial[lowBits];
  286.                 goto do_send;
  287.  
  288.             case 13: /* send a special ternary keyword messae */
  289.                 numargs = 2;
  290.                 message = keyspecial[lowBits];
  291.                 goto do_send;
  292.  
  293.             case 14: /* block creation */
  294.                 numargs = lowBits;
  295.                 if (numargs)
  296.                     nextbyte(arglocation);
  297.                 nextbyte(i);    /* size of block */
  298.                 push(new_block(anInterpreter, numargs,
  299.                     arglocation));
  300.                 skip(i);
  301.                 break;
  302.  
  303.             case 15: /* special bytecodes */
  304.                 spcount[lowBits]++;
  305.                 switch(lowBits) {
  306.                 case 0: /* no - op */
  307.                     break;
  308.                 case 1: /* duplicate top of stack */
  309.                     push(*(anInterpreter->stacktop - 1));
  310.                     break;
  311.                 case 2: /* pop top of stack */
  312.                     anInterpreter->stacktop--;
  313.                     break;
  314.                 case 3: /* return top of stack */
  315.                     tempobj = popstack();
  316.                     goto do_return;
  317.                 case 4: /* block return */
  318.                     block_return(anInterpreter, popstack());
  319.                     return;
  320.                 case 5: /* self return */
  321.                     tempobj = tempvar(0);
  322.                     goto do_return;
  323.                 case 6: /* skip on true */
  324.                     nextbyte(i);
  325.                     tempobj = popstack();
  326.                     if (tempobj == o_true) {
  327.                         skip(i);
  328.                         push(o_nil);
  329.                         }
  330.                     break;
  331.                 case 7: /* skip on false */
  332.                     nextbyte(i);
  333.                     tempobj = popstack();
  334.                     if (tempobj == o_false) {
  335.                         skip(i);
  336.                         push(o_nil);
  337.                         }
  338.                     break;
  339.                 case 8: /* just skip */
  340.                     nextbyte(i);
  341.                     skip(i);
  342.                     break;
  343.                 case 9: /* skip backward */
  344.                     nextbyte(i);
  345.                     skip( - i );
  346.                     break;
  347.                 case 10: /* execute a primitive */
  348.                     nextbyte(numargs);
  349.                     nextbyte(i); /* primitive number */
  350.                     if (i == BLOCKEXECUTE)
  351.                         goto blk_execute;
  352.                     else if (i == DOPERFORM)
  353.                         goto do_perform;
  354.                     else {
  355.                         decstack(numargs);
  356.                         tempobj = primitive(i, numargs,
  357.                         anInterpreter->stacktop);
  358.                         push(tempobj);
  359.                         }
  360.                     break;
  361.                 case 11: /* skip true, push true */
  362.                     nextbyte(i);
  363.                     tempobj = popstack();
  364.                     if (tempobj == o_true) {
  365.                         skip(i);
  366.                         anInterpreter->stacktop++;
  367.                         }
  368.                     break;
  369.                 case 12: /* skip on false, push false */
  370.                     nextbyte(i);
  371.                     tempobj = popstack();
  372.                     if (tempobj == o_false) {
  373.                         skip(i);
  374.                         anInterpreter->stacktop++;
  375.                         }
  376.                     break;
  377.                 default:
  378.                     cant_happen(9);
  379.                 }
  380.                 break;
  381.             }
  382.         }
  383.     /* sorry for the unstructured gotos.
  384.         the sins of unstructuredness seemed less bothersome than
  385.         the problems of not doing the same thing in all places
  386.                         -tab
  387.         */
  388.     do_perform:    /* process perform:withArguments: */
  389.         tempobj = popstack();
  390.         message = symbol_value(tempobj);
  391.         tempobj = popstack();
  392.         numargs = tempobj->size - 1;
  393.         for (i = 0; i <= numargs; i++)
  394.             push(tempobj->inst_var[i]);
  395.         /* fall through into do_send */
  396.  
  397.         /* do_send - call courier to send a message */
  398.     do_send:
  399.         receiver = *(anInterpreter->stacktop - (numargs + 1));
  400.     do_send2:
  401.         decstack(numargs + 1);
  402.         send_mess(anInterpreter, receiver, message,
  403.             anInterpreter->stacktop , numargs);
  404.         return;
  405.  
  406.         /* do_return - return from a message */
  407.     do_return:
  408.         sender = anInterpreter->sender;
  409.         if (is_interpreter(sender)) {
  410.             if (! is_driver(sender))
  411.                 push_object(sender, tempobj);
  412.             link_to_process(sender);
  413.             }
  414.         else {
  415.             terminate_process(runningProcess);
  416.             }
  417.         return;
  418.  
  419.         /* blk_execute - perform the block execute primitive */
  420.     blk_execute:
  421.         tempobj = popstack();
  422.         if (! is_integer(tempobj)) cant_happen(9);
  423.         numargs = int_value(tempobj);
  424.         sender = block_execute(anInterpreter->sender,
  425.             (block *) tempvar(0), numargs, &tempvar(1));
  426.         link_to_process(sender);
  427.         return;
  428. }
  429.